COMMENT ⊗   VALID 00012 PAGES VERSION 17-1(18)
RECORD PAGE   DESCRIPTION
 00001 00001
 00005 00002	HISTORY
 00008 00003	Comser Data -- Povtab, Dsplin stuff
 00010 00004	Strngc Supply Routines for Compiler Structures
 00012 00005	Compiler-Specific portion of Error UUO stuff
 00022 00006	 SERVICE ROUTINES TO MYERR
 00024 00007	MORE SERVICE ROUTINES FOR MYERR
 00028 00008	DSCR PRINT.
 00030 00009	Dsplin Routine for Displaying Input Line
 00034 00010	Interrupt Handler -- Intrpt, Povtrp
 00040 00011	
 00041 00012	
 00042 ENDMK
⊗;
COMMENT ⊗HISTORY
AUTHOR,REASON
021  102100000022  ⊗;


COMMENT ⊗
VERSION 17-1(18) 3-19-74 BY RHT LOOK OVER CODE WITH RLS
VERSION 17-1(17) 3-17-74 BY RLS INSTALL TENEX
VERSION 17-1(16) 12-8-73 BY JRL REMOVE SPECIAL STANFORD CHARACTERS(WHERE POSSIBLE)
VERSION 17-1(15) 11-17-73 
VERSION 17-1(14) 11-10-73 BY KVL %AI% ADD <ESC> I INTERRUPT TO RESET ERROR HANDLER
VERSION 17-1(13) 7-26-73 BY RHT **** VERSION 17 ****
VERSION 16-2(12) 6-29-73 BY JRL END RINGSORT WITH POPJ P,
VERSION 16-2(11) 3-13-73 BY JRL REMOVE REFERENCES TO GAG
VERSION 16-2(10) 7-3-72 BY DCS INSTALL VERSION 16
VERSION 15-2(9) 2-26-72 BY DCS <ESC> I ALWAYS BREAKS
VERSION 15-2(8) 2-6-72 BY DCS BUG #GM# RETURN ADDRESS BEING WIPED OUT IN POVTRP
VERSION 15-2(7) 2-5-72 BY DCS BUG #GJ# ADD LSTON LISTING CONTROL STUFF
VERSION 15-2(6) 2-1-72 BY DCS BUG #GH# <ESC>I CAUSES PARSER TO BREAK AFTER NEXT SCAN
VERSION 15-2(5) 12-26-71 BY DCS BUG #FU# REENABLE ACCESS TO FTDEBUG FROM ERR UUO
VERSION 15-2(4) 12-22-71 BY DCS BUG #FT# DSPLIN CLEANED UP
VERSION 15-2(3) 12-22-71 BY DCS BUG #FT# MYERR RETURNS BINLIN (SEQUENTIAL LINE #)
VERSION 15-2(2) 12-21-71 BY DCS BUG #FS# REMOVE COM2 REFS (ASSUME RUNTIM OR LIB)
VERSION 15-2(1) 12-2-71 BY DCS INSTALL VERSION NUMBER

⊗;
COMMENT ⊗Comser Data -- Povtab, Dsplin stuff⊗
	LSTON	(COMSER)

BEGIN COMSER		;SERVICE ROUTINES FOR COMPILER.

ZERODATA (COMSER VARIABLES)

COMMENT ⊗
POVTAB -- table of ASCIZ strings, one per AC, giving reasonable
    messages to be typed when PDL overflow occurs. 0 if none
    provided -- set up in POVSET from SAIL INIT -- changed 
    occasionally as needs change.  Used by POVTRP below
⊗
↑↑POVTAB: BLOCK  10

;PDLSV, PDLSV1 -- save AC's when PDL trapping
?PDLSV: 0
?PDLSV1:0

DATA (COMSER VARIABLES)

COMMENT ⊗
DSPLIN and MYERR variables
⊗
DLINBF:	BLOCK 53

ENDDBF←DLINBF+53

DATA(LOGGING VARIABLES)

NOTENX <
MAKCDB(LOG,LOG,0,0,1)
>;NOTENX
TENX <
LOGJFN:	0	;LOGFLN, a bp to log file name, is set up in SAIL
		;in the command scanner
>;TENX

ZERODATA( LOGGING VARIABLES)

↑..STR:0
↑..LOCA:0
↑%QUIET:	0
%MINUS:	0
%NUMBS:	0
%LOGGIN:0

ENDDATA
COMMENT ⊗Strngc Supply Routines for Compiler Structures⊗

;          SORT THE STRINGS IN SYMBOL TABLE

DSCR RINGSORT
CAL PUSHJ from STRINGC.
DES It passes off to the GC all of the Strings located in
  symbol table Semblks in the compiler. It does this by
  searching down the %RSTR ring (STRRNG).
⊗

T←←11

↑RINGSORT:
	HRRZ	T,STRRNG	;PTR TO LAST BLOCK IN STRING RING
	JUMPE	T,CPOPJ		;DONE WHEN 0, GO MARK VARIABLES
RGSLUP:	MOVEI	A,$PNAME(T)	;PTR TO STRING DESCRIPTOR
	PUSHJ	P,@-1(P)	;SORT IT INTO LISTS
	HLRZ	T,%RSTR(T)	;NEXT BLOCK
	JUMPN	T,RGSLUP	;CONTINUE UNLESS DONE
	POPJ	P,


;	   SORT STRINGS IN DEFINE STACK
DSCR DEFSRT
CAL PUSHJ from STRINGC
DES Passes off all Strings currently in the Define stack to be collected.
⊗;

↑DEFSRT:
	HRRZ	A,DFSTRT	;SORT STRINGS ON DEFINE STACK
	HRRZ	T,DEFPDP	;TERMINATION VALUE
	SUBI	A,1		;INIT
	JRST	SGDTST		;JUMP INTO THINGS

DEFMRK:	
	PUSHJ	P,@-1(P)	;SORT INTO STRUCTURE
SGDTST:
	ADDI	A,2		;AUTO-INCR DOESN'T GO FAR ENOUGH
	CAMGE	A,T		;DONE?
	JRST	DEFMRK		; NO
	POPJ	P,		; YES


	RINGSORT		;1 ROUTINE
	0
	LINK 4,.-1		;FOR STRING GARBAGE COLL.

	DEFSRT
	0
	LINK 4,.-1		;AND ANOTHER ROUTINE.


COMMENT ⊗Compiler-Specific portion of Error UUO stuff⊗

IMSSS<;MYERR FOR IMSSS SYSTEM
DSCR MYERR
DES Part of the second segment kludge -- so that the error
  handler can call some routines which are specific to the
  compiler. There routines are -- display the current line.
  -- call the editor on the current input file.
⊗;
IFN FTDEBUG,<
	INNA			;FR0M ERR -- TO LOOK AT STACK
;>	0			;NO DEBUGGER
↑↑MYERR:

DSCR
	Glorious IMSSS EDITOR interface. (Patent pending.)
	Here we are going to decide whether we want to edit,	
and if so, which editor.
	If ac A has 1, then we want some kind of edit.
	The information as to which editor we use is on the
stack -- 0 for whichever editor is appropriate to the device, 
non-zero for STOPGAP, regardless of the device.
	The only difference, apart from the run call, is the contents
of TMPCBF+4.  This is the linenumber.  
	EDITOR		CONTENTS of TMPCBF+4
	------       	---------------------
	TVEDIT		physical linenumber on the page
	TEC		xwd byteno,lineno
			where byteno is the bytenumber on the
			line, and lineno is the linenumber on the
			page
	SOS		the ASCID STOPGAP linenumber as stored by the
			scanner.
⊗;

EXTERNAL JFNS,CVSIX,JFNTBL,RUNPRG

DEFINE JFNSMK(X,Y)<
	PUSH	P,[1]
	PUSH	P,[XWD X,0]
	PUSHJ	P,JFNS
	PUSHJ	P,CVSIX
	MOVEM	A,Y
>

	CAIE	A,1		;REQUEST FOR EDIT?
	   JRST NOE		;NO

;definitely call some editor.  First store things that
;are the same for all editors.

	MOVE	TEMP,[XWD TMPCBF,TMPCBF+1]
	SETZM	TMPCBF
	BLT	TEMP,TMPCBF+37			;clear before starting
	MOVEW	JFNTBL+1,SRCJFN	;FAKE FOR JFNS -- WHAT A KROK
	MOVEW	TMPCBF+32,<[SIXBIT/SYS/]>
	MOVEW	TMPCBF+33,<[SIXBIT/SAIL/]>	;return to SAIL
	MOVE	TEMP,[XWD CMDLIN,TMPCBF+6]
	BLT	TEMP,TMPCBF+30			;COPY OVER COMMAND
	EXCH	SP,STPSAV			;GET STRING PDL
	JFNSMK(001000,TMPCBF)			;GET FILE NAME PIECES
	JFNSMK(000100,TMPCBF+1)	
	JFNSMK(010000,TMPCBF+3)
	MOVEW	TMPCBF+5,FPAGNO			;page number
	SKIPN	-1(P)		;STOPGAP?
	  JRST	DECIDE		;NOPE, DECIDE WHICH EDITOR
DOSOS:	SKIPN	TEMP,ASCLIN	;THE LINE NO
	  MOVE	TEMP,[ASCID/00000/];SUPPLY ONE
	TRO	TEMP,1		;TURN ON BIT, IN CASE OFF
	MOVEM	TEMP,TMPCBF+4
;STORE RUNCALL INFO IN TEMP
	MOVEI	TEMP,[ =16
		      POINT 7,[ASCIZ/<SUBSYS>EDIT.SAV/],-1]
	JRST	DORUNC		;DO THE RUN CALL

DECIDE:
;HERE WE WANT TO DECIDE WHICH EDITOR TO CALL
;FIRST, GET THE TENEX TTYNO.
;THIS CODE IS TEMPORARY UNTIL TENEX KNOWS WHAT
;IT IS DOING.
	JSYS 	GJINF			;GET THE JOB INFORMATION
	MOVE	1,4		;TTY NO.
	SETO	2,		;NO HSL NO.
	JSYS	TTCVT		;GET HSL TTYNO. IN OLD STYLE
	LSH	2,-=9		;EXTRACT HSL NO.
	CAIN	2,5		;IS IT SOME TEC?
	   JRST	DOTEC		;YES
	CAIL	2,14		;CURRENT IMLAC RANGE 14-26
	CAILE	2,26	
	   JRST	DOSOS		;DEFAULT TO SOS
	MOVE	TEMP,BINLIN
	SUBI	TEMP,1		;BECAUSE TVEDIT WANTS ONE LESS
	MOVEM	TEMP,TMPCBF+4

	MOVEI	TEMP,[=18
		      POINT 7,[ASCIZ/<SUBSYS>TVEDIT.SAV/],-1]
;HERE FOR ACTUAL PASSAGE OF INFO AND CALL TO EDITOR
DORUNC:
	SETO	A,
	MOVEI	B,TMPCBF
	JSYS	PTINF		;SPECIAL IMSSS PTINF JSYS
	  JFCL

	MOVEI	A,400000	;THIS FORK
	SETO	B,
	JSYS	DIC		;DEACTIVATE ALL CHANNELS
	JSYS	CIS		;CLEAR INTERRUPT SYSTEM
	MOVEI	A,10		;CONTROL-H INTERRUPT
	JSYS	DTI		;DISABLE IT

	PUSH	P,[1]		;INCREMENT FOR CCL STUFF
	PUSH	P,[0]		;SAME FORK
	PUSH	SP,(TEMP)	;PROGRAM TO RUN
	PUSH	SP,1(TEMP)
	PUSHJ	P,RUNPRG
	HRROI	A,[ASCIZ/
Runcall error for IMSSS editor interface.
/]
	JSYS	PSOUT
	EXCH	SP,STPSAV	;PUT BACK THE STRING PDL
	JRST	SAIL


DOTEC:	MOVE	TEMP,BINLIN	;LINE NUMBER
;TRICKY CODE TO GET THE BYTE NUMBER
	MOVE	A,PNEXTC	;BP TO NEXT CHAR
	SKIPN	LSTCHR		;NEED TO BACK UP BP?
	   JRST	DOTEC1		;NO
	REPEAT 4,<IBP A>
	SOJ	A,		;BACK IT UP
DOTEC1:	SETZ	C,		;KEEP COUNT IN 3
	MOVE	B,PLINE		;POINTER TO BEGINNING OF CURRENT LINE

DOTECL:	IBP	B		;INCREMENT
	AOJ	C,		;ONE MORE CHAR
	CAMN	A,B		;SAME YET?	
	  JRST	GOTIT		;YES
	CAIG	C,=300		;NO LINE GOES MORE THAN 300 CHARS
	  JRST 	DOTECL		;ANOTHER	
	SETZ	C,		;ASSUME NONE
GOTIT:
	HRL	TEMP,C		;XWD BYTENO,LINENO

	MOVEM	TEMP,TMPCBF+4	;STORE IT
	MOVEI	TEMP,[=15
		      POINT 7,[ASCIZ/<SUBSYS>TEC.SAV/],-1]
	JRST	DORUNC		;STORE INFO AND DO RUN CALL

>;IMSSS
NOIMSSS<;MYERR FOR NON-IMSSS SYSTEM
COMMENT ⊗Compiler-Specific portion of Error UUO stuff⊗

DSCR MYERR
DES Part of the second segment kludge -- so that the error
  handler can call some routines which are specific to the
  compiler. There routines are -- display the current line.
  -- call the editor on the current input file -- log error messages.
⊗;
↑↑MYERR:
TENX <
	JRST	NOE		;NO EDIT INTERFACE ON 10X (SEE IMSSS CODE
				;FOR SOME BAD IDEAS)
>;TENX
NOTENX <
	MOVE	13,SRCFIL	;FILE NAME NEEDED IN ANY CASE
	MOVE	14,SRCEXT
	MOVE	11,SRCPPN
	SKIPE	A,-1(P)		;GO TO EDITOR?
	 JRST 	NOE		;NOPE, DO DSPLIN & LOGGING STUFF
	MOVE	16,FPAGNO	;AS IS THIS
	SKIPN	15,ASCLIN
	MOVE	15,[ASCID/00000/]
	TRO	15,1		;FOR WFW
	SKIPA	12,BINLIN	;TV WILL WANT THIS NUMBER INSTEAD
>;NOTENX
>;NOIMSSS

GOHOHO:	SUB	SP,X44			;GET RID OF STRINGS
       	SUB	P,X22
	JRST	@2(P)

NOE:	HRRZM	A,..LOCA	;STORE NUMBERS
	MOVE	A,-2(SP)	;GET STRING
	HRRZM	A,..STR		;STORE IT TOO
	SKIPL	%RECOV
	 SETZM	%QUIET		;MAKE FATAL ERRORS PRINT
	PUSHJ	P,ERPRIN	;PRINT MSG, ETC.
	SKIPE	%ERGO		;AUTO CONTINUE?
	 JRST	HOME2
;;#PR# RHT FLUSH TYPE AHEAD (1 OF 2)
	PUUO	2,B		;INCHRS
	JRST	PROMPT		;NO TYPE AHEAD
	PUUO	11,0		;CLEAR BUFFER
	CAIN	B,12		;ONLY USE TYPE AHEAD IF WAS A LF
	JRST	CHRGOT		;HAVE GOT IT
;;#PR#
PROMPT:	PUUO	3,CRLF..
	MOVEI	A,"?"		;PRINT ? FOR IRRECOVERABLE ERRORS,
	SKIPGE	%RECOV		;CAN CONTINUE?
	MOVEI	A,"↑"		;SOMETHING PRINTABLE
	PUUO	1,A		;PRINT IT
NOPROM:
	PUUO	0,B		;GET RESPONSE CHAR
CHRGOT:	PUSHJ	P,DSPATC	;GO DO THE RIGHT THINGS
	JRST	HOME0		;GOT AN ACTIVATION LETTER
	SKIPE	%MINUS		;DONOT PROMPT IF WE RECEIVED A MINUS
	JRST	NOPROM
	JRST	PROMPT
;;#PR#
HOME0:	CAIN	B,15		;IF A CR
	PUUO	2,A		;GOBBLE THE LF
	JRST	HOME1		;NOT ONE THERE
	JRST	HOME1		;
;;#PR#
HOME2:	SKIPA	A,[0]
HOME1: 	HRRZ	A,B			;PUT LEFTOVER CHARACTER IN
	TLO	A,3			;DO NOT PRINT OR GIVE NUMBERS
	JRST	GOHOHO			; AND A BOTTLE OF RUM
; SERVICE ROUTINES TO MYERR
;Dspatc is also called from GEN in the routine that does REQUIRE ERROR!MODES.
;Dspatc skip returns if the contents of B was any of the error modes.
;It does a regular return if B was any of the activation responses.
;It skip returns if it doesn't recognize the character.
↑DSPATC:
	CAIL	B,"a"		;lower case?
	SUBI	B,40		;YES, CONVERT TO UPPER
	CAIN	B,"Q"
	  JRST SETQT
	CAIN	B,"N"
	  JRST SETNUM
	CAIN	B,"L"
	  JRST SETLOG
	CAIN	B,"F"
	  JRST SETFL
	CAIN	B,"-"
  	  JRST SETMN
	CAIN	B,"B"
	  JRST	DEBUGA

	CAIE	B,12		;LF
	CAIN	B,15		;CR
	  JRST	GOTRY
	CAIE	B,"X"
	CAIN	B,"S"
	  JRST	GOTRY
	CAIE	B,"T"
	CAIN	B,"E"
	  JRST	GOTRY
	CAIE	B,"B"
	CAIN	B,"D"
	  JRST	GOTRY
	CAIE	B,"A"
	CAIN	B,"C"
	  JRST	GOTRY
	PUUO	3,[ASCIZ /ERROR MODES ARE: Q(QUIET), L OR F (LOGGING), N (NUMBERS).
PRECEDE A MODE LETTER BY - TO RESET THE MODE. ACTION RESPONSES ARE: <CR>(CONTINUE),
<LF>(AUTO CONT), D(DDT), B(DEBUGGER), E(SOS), T(TV EDITOR), X (EXIT), S(RESTART)
/]
GOFLY:	AOS	(P)			;SKIP RETURN (SETMN ROLLS ITS OWN)
GOTRY:	SETZM	%MINUS
	POPJ	P,

;MORE SERVICE ROUTINES FOR MYERR
SETMN:	SETOM	%MINUS
	AOS	(P)
	POPJ	P,

SETNUM:	SKIPE	%MINUS
	SOSA	%NUMBS
	AOSA	%NUMBS
	JRST	GOFLY			;GO AWAY, HE DOESNOT WANT NUMBERS
	JRST	DOOVER
	
SETQT:	SKIPN	%MINUS
	AOSA	%QUIET
	SOSA	%QUIET
	JRST	GOFLY			;GO AWAY - HE WANTS QUIET
DOOVER:	PUSH	P,%LOGGIN		;SAVE
	SETZM	%LOGGIN
	PUSHJ	P,ERPRIN  		;PRINT AGAIN - DON'T BOTHER GETTING %ERFLGS
	POP	P,%LOGGIN		;RESTORE
	JRST	GOFLY			

NOTENX <
SETFL:	RELEASE	LOG,0
	SETZM	%LOGGIN
	SKIPE	%MINUS
         JRST	GOFLY			;THE END (WAS A -F)
	PUSH	P,TTYTYI		;SPECIAL INCHWL KLUGE
	SETOM 	TTYTYI			;
	HRLZI	14,'LOG'		;
	MOVEM	14,EXTEN		;
	PUSHJ	P,FILNAM		;I HOPE THIS DOESN'T CLOBBER NAME... TOO BAD
	POP	P,TTYTYI		;
	SKIPE	NOFILE
	  JRST	[PUUO 3,[ASCIZ/INVALID FILE NAME SYNTAX
/]
	  JRST	GOFLY]
	JRST	SETLF

SETLOG:	RELEASE	LOG,0			;ALWAYS START WITH CLEAN SLATE
	SETZM	%LOGGIN
	SKIPE	%MINUS
	 JRST	GOFLY			;WAS A -L
	HRLZI	TEMP,'LOG'		;DEFAULT EXTENSION
	MOVEM	TEMP,EXTEN
	MOVE	TEMP,SRCPPN		;REDUNDANCY FOR REQUIRE...ERROR!MODES BENEFIT
	MOVEM	TEMP,PPN
	MOVE 	TEMP,SRCFIL
	MOVEM	TEMP,NAME
SETLF:	HRLZI	TEMP,'DSK'
	MOVEM	TEMP,LOGDEV		;
	MOVEI	SBITS2,LOGCDB		;READY TO OPEN LOG FILE
	PUSHJ	P,OPNUP			;OPEN SEZ ME!
	  JRST  [PUUO 	3,[ASCIZ /ERROR LOGGER: OPEN FAILURE
/]
		JRST GOFLY]
	  JRST  [PUUO 	3,[ASCIZ /ERROR LOGGER: ENTER FAILURE
/]
		JRST GOFLY]
>;NOTENX

TENX <
SETFL:	MOVEI	A,ELOGF			;FILENAME FROM TERMINAL
	JRST	SETXX
SETLOG:	MOVEI	A,ELOGL			;STANDARD FILENAME
SETXX:	SETZ	B,
	JSYS	GTJFN
	 JRST	BDLGFL
	MOVE	B,[XWD 70000,100000]	;7 bit writing
	JSYS	OPENF
	 JRST	BDLGFL
	EXCH	1,LOGJFN		;Take care of any leftover jfn
	JUMPG	1,[	HRRZI	1,(1)	;Clear lh so CLOSF will also do RLJFN
			JSYS	CLOSF
			 JFCL
			JRST	.+1]
>;TENX
	SETOM	%LOGGIN
	PUSH	P,%QUIET		;SAVE FLAGS
 	SETOM	%QUIET			;MAKE IT NOT PRINT
	PUSHJ	P,ERPRIN  		;PRINT AGAIN
	POP	P,%QUIET		;RESTORE FLAGS
	JRST	GOFLY

TENX <
BDLGFL:	HRROI	1,[ASCIZ /
Cannot set up your logfile.
/]
	JSYS	PSOUT
	JRST	GOFLY

;long form GTJFN block -- this is for default file name
ELOGL:	XWD 	400000,0
	XWD	377777,377777
	0
	0
	XWD	-1,DEFFLN		;set in CC
	XWD	-1,[ASCIZ/LOG/]
	BLOCK	3

;this one is for file from terminal
ELOGF:	XWD	460000,0		;CONFIRM BITS ON
	XWD	100,101
	0
	0
	XWD	-1,DEFFLN
	XWD	-1,[ASCIZ/LOG/]
	BLOCK	3

>;TENX

DEBUGA: 
IFN FTDEBUG <PUSHJ	P,INNA		;GO TO COMPILER DEBUGGER
>; FTDEBUG
	JRST	GOFLY
DSCR PRINT.
PAR A points to some asciz
SID none
DES prints the string given it, and logs it out if the
guy is enabled for that.
⊗

↑↑PRINT.:
	SKIPN	%QUIET
	 PUUO 	3,(A)		;PRINT THE MSG
	SKIPN	%LOGGIN	
	 POPJ	P,
	PUSH	P,B

NOTENX <
	HRLI	A,(<POINT 7,0>)	;BYTE POINTER
 GG..:	ILDB	B,A		;GET BYTE
	JUMPE	B,MPOPJ		;END OF LINE
	SOSG	LOGCNT
	OUTPUT	LOG,
	IDPB	B,LOGPNT
	JRST	GG..
>;NOTENX
TENX <
	HRROI	2,(1)
	HRRZ	1,LOGJFN
	PUSH	P,3
	SETZ	3,
	JSYS	SOUT
	POP	P,3
>;TENX
MPOPJ:	POP	P,B
      	POPJ	P,		;SUPER-DUPER ERROR RECOVERY, HUH?


ERPRIN:	
	MOVE	A,..STR		;GET MSG - ITS ALREADY ASCIZ!
	PUSHJ	P,PRINT.	;PRINT IT!
	PUSHJ	P,DSPLIN	;PRINT CURRENT LINE AND SUCH
	SKIPN	%NUMBS		;WANT NUMBERS?
	POPJ	P,
	MOVEI	A,[ASCIZ /CALLED FROM /]
	PUSHJ	P,PRINT.
	MOVE	B,..LOCA	;THE LOCATION
	SUBI	B,1
	PUSH	P,C
	PUSHJ	P,PRNT.
	POP	P,C
	MOVEI	A,CRLF..
	PUSHJ	P,PRINT.
	POPJ	P,

PRNT.:	IDIVI	B,10		;FAMOUS DEC RECURSIVE NUMBER PRINTER.
	IORI	C,"0"
	HRLM	C,(P)
	SKIPE	B
	PUSHJ	P,PRNT.
	HLRZ	C,(P)
	ROT	C,-7
	MOVEI	A,C
	PUSHJ	P,PRINT.
	POPJ	P,		

CRLF..: ASCIZ /
/
COMMENT ⊗Dsplin Routine for Displaying Input Line⊗

DSCR DSPLIN
PAR Line specs from compiler,
CAL PUSHJ
RES Types out current input line on tty, may log if that is on.
SID changes A,B,C,TEMP
⊗

↑DSPLIN: 
	SETZM	DLINBF
	MOVE	TEMP,[XWD DLINBF,DLINBF+1]
	BLT	TEMP,ENDDBF-1	;MAKE ALL DISPLAY BUFFER ASCID
	PUSH	P,PNEXTC	;SAVE BECAUSE MIGHT GRONK
	SKIPN	LSTCHR
	JRST	NOBAK
	REPEAT 4,<IBP PNEXTC
>
	SOS	PNEXTC
NOTENX <
NOBAK:	PUSH	P,12		;SAVE TEMPORARILY
	PUSH	P,B
	MOVE	12,[POINT 7,DLINBF] ;OUTPUT POINTER, PRINSYM WANTS HERE
	MOVE	A,SRCFIL	;PRINT FILE NAME
	PUSHJ	P,PRINSYM	;WITH THIS ROUT
	MOVE	TEMP,12		;OUTPUT HERE FROM NOW ON
	POP	P,B
	POP	P,12
>;NOTENX
TENX <
NOBAK:	PUSH	P,B	
	MOVE	TEMP,[POINT 7,DLINBF]	;OUTPUT POINTER
	MOVE	A,[POINT 7,SRCFLN]	;NAME, SET UP IN CC
	PUSHJ	P,ASCFIL		;COPY OVER, LEAVING UPDATED BP IN TEMP
	POP	P,B
>;TENX
	MOVE	D,FPAGNO
	SETZM	BKR		;DENOTE 0 AS BREAK CHAR
	MOVE	A,[POINT 7,[ASCII /, PAGE /]]
	PUSHJ	P,ASCFIL	;TELL HIM WHAT IT IS
	PUSHJ	P,DECFIL	;STUFF PAGE NUM IN BUFFER
	MOVE	A,[POINT 7,[<BYTE (7) 15,12>]] ;MAKE SPACE
	PUSHJ	P,ASCFIL
	SETOM	BKR		;BREAK ON 0, 177, OR 12
	MOVE	A,[POINT 7,ASCLIN] ;PREPARE TO OUTPUT LINE NO.
	SKIPE	(A)
	PUSHJ	P,ASCFIL	;DO IT
	MOVE	A,[POINT 7,[ASCII /   /]]
	PUSHJ	P,ASCFIL
	MOVE	C,SCNWRD	;GET LIST CONTROL BITS
	TLNN	C,4000		;IN A MACRO?
	JRST	NOMAC		;NO
	HRRZ	C,DFSTRT
	MOVE	C,2(C)		;PNEXTC AT THAT TIME
	MOVEM	C,FILBP		;ARROW CONTROL
	MOVE	A,IPLINE	;WHERE IT ALL BEGAN
	PUSHJ	P,ASCFIL	;DO THE LINE
	SETZM	BKR		;TEMP
	MOVE	A,[POINT 7,[BYTE (7) 15,12,12]]
	PUSHJ	P,ASCFIL	;GO TO NEXT LINE
	SETOM	BKR
	MOVE	A,[POINT 7,[ASCIZ /        /]]
	SKIPE	ASCLIN		;IF PUT OUT LINE BEFORE,
	PUSHJ	P,ASCFIL	;MATCH IT
NOMAC:	MOVE	C,PNEXTC	;SAME FOR CURRENT LINE
	MOVEM	C,FILBP
	MOVE	A,PLINE
	PUSHJ	P,ASCFIL
	MOVEI	A,0
	IDPB	A,TEMP		;MAKE INTO ASCIZ
	SETZM	FILBP		;PRECAUTION
;;%AI% 11/10/73 KVL STANDARDIZE ERROR PRINTING
	MOVEI	A,DLINBF	;PRINT (AND/OR LOG) MESSAGE
	PUSHJ	P,PRINT.
;; %AI%
POPOP:	POP	P,PNEXTC	;GET REAL ONE BACK
	POPJ	P,

↑.CORERR:ERR	<NO CORE AVAILABLE>
COMMENT ⊗Interrupt Handler -- Intrpt, Povtrp⊗

DSCR POVTRP
CAL SYSTEM INTERRUPT
PAR JOBTPC is 1 past bad instr.
RES POVTAB(offending AC) is inspected for a string address.
  If it is there, the string is TTYOUTed as an error, indicating
  to the user which PDL oved. This is a fatal error message.
  Continuation is in general quite futile.
⊗
;;%AY% -- REWORK TO USE THE RUNTIME ROUTINES

;;#GH# DCS 2-1-72 (5-5) <ESC>I CAUSES PARSER TO BREAK AFTER NEXT SCAN
NOTENX <
↑INTRPT:
NOEXPO <
;; RHT 2-12-73 INTMOD NOW DOES THE DISPATCH (%AY%)
;;	MOVE	TEMP,JOBCNI	;REASON
;;	TLNN	TEMP,INTTTI	;<ESC> I?
;;	 JRST	 POVDO		; NO, PDL OV
;; %AI% 11/10/73 KVL <ESC> I RESETS THE ERROR HANDLER
↑ITTYDO:
	SETZM	%QUIET
	SETZM	%ERGO		;MAKE THE NEXT ERROR VISIBLE
IFN FTDEBUG, <
	MOVE	TEMP,[XWD 400000,377777];INTERRUPT INDICATION
	SETZM	MULTP		;NOT IN MULTIPLE-PROCEED,
	MOVEM	  TEMP,.DBG.	;  IT IS GOING TO STOP
>;IFN FTDEBUG
	CALL6	DISMIS		; OR ELSE COULD JUST RETURN
↑POVDO:
EXTERNAL XJBTPC
	MOVE	LPSA,GOGTAB	;
	MOVE	TEMP,XJBTPC	;REAL TRAP LOCN
	MOVEM	TEMP,UUO1(LPSA)	;"RETURN"
	CALL6	(UWAIT)		;GET OUT OF MONITOR MODE, GET ACS
	CALL6	(DEBREAK)	;"JRST" .+1

>;NOEXPO
;;#GH# (5-5)
EXPO <
;; IN THIS CASE, MUST SIMULATE A DEBREAK.
↑POVDO:
	MOVE	LPSA,GOGTAB	;
	MOVE	TEMP,JOBTPC	;REAL TRAP LOCN
	MOVEM	TEMP,UUO1(LPSA)	;"RETURN"
	MOVEI	TEMP,POVTRP	;WHERE GO TO
	MOVEM	TEMP,JOBTPC	;
	POPJ	P,		;THIS "DISMISSES" US
>;EXPO
;;%AY% 
↑POVTRP: MOVEM	TEMP,PDLSV	;SAVE ACS
	MOVEM	LPSA,PDLSV1
;;#GM# DCS 2-6-72 (1-1) WAS WIPING OUT TEMP WITH MOVEW
	MOVE	LPSA,GOGTAB	;NOW RECORD WHERE IT HAPPENED FOR ERR MSG
;;%AY%	MOVEW	UUO1(LPSA),JOBTPC -- USED TO BE
	MOVE	TEMP,UUO1(LPSA)	;CAREFULLY SET UP ABOVE
>;NOTENX

TENX <
;First the TENEX equivalent of <ESC>I - currently control H - which
;is copied somewhat blindly from DCS's code @ INTRPT above. The only
;other TENX switched code related to this is in SAILNIT where
;the compiler sticks the right vector into the channel table to direct
;the interrupt here and arm the control character (ATI jsys).
↑ITTYDO: SETZM	%ERGO
	SETZM	%QUIET
	SETZM	MULTP
	MOVEM	TEMP,.DBG.	;SAVE TEMP
	MOVE	TEMP,[XWD 400000,377777]	;MAGIC NUMBER WORKS FOR DCS
	EXCH	TEMP,.DBG.	;OUGHT TO WORK FOR ME. RESTORE TEMP
	JSYS	DEBRK		;CONTINUE INTERRUPTED CODE


;Now for PDLOV stuff. Like <ESC I> requires SAIL init. to set up CHNTAB
;but in this case it MUST set it up as a level 3 interrupt or at least
;the same level assumed by the EXCH below. Also Stanford people beware
;of TENEX DEBRK which is just different enough from your DEBREAK to be
;confusing.  See a JSYS manual. 

EXTERNAL	LPC3
↑POVDO: MOVEM	TEMP,PDLSV
	MOVEM	LPSA,PDLSV1
	HRRZI	TEMP,.+3
	 EXCH	TEMP,LPC3	;ASSUME LEVEL 3. FORCE CONTINUATION
				;OF INTERRUPTED CODE AT THE DEBRK+1
	 JSYS	DEBRK

;BACK TO NORMAL USERMODE NOW; AC'S NOT CHANGED (I.E. SAVED OR RESTORED)
;THUS TEMP STILL HOLDS REAL INTERRUPT ADDR FOR PUTTING INTO JOBTPC
>;TENX
	MOVEM	TEMP,JOBTPC	;SO CODE BELOW WORKS (A REAL HACK)
;;#GM# (1-1) TEMP STILL HOLDS JOBTPC
	LDB	TEMP,[POINT 4,-1(TEMP),12] ;HOW DID IT HAPPEN?
	ADDI	TEMP,17		;ADJUSTMENT
	ANDI	TEMP,17
	ROT	TEMP,-1		;GET INDEX TO HALF-WORDS, LOW BIT TO SIGN
	HRRZ	LPSA,POVTAB(TEMP) ;ASSUME ODD -- RIGHT HAND
	JUMPL	TEMP,.+2	;CORRECT
	HLRZ	LPSA,POVTAB(TEMP);EVEN -- WRONG
	JUMPN	LPSA,.+2	;WAS THERE A CLUE?
	MOVEI	LPSA,[ASCIZ /UNKNOWN STACK/]
	ERRPRI	<PUSH-DOWN OVERFLOW -- >	;TELL HIM SOME
	MOVE	TEMP,PDLSV
	EXCH	LPSA,PDLSV1		;RESTORE ACS
	ERR.	@PDLSV1			;TELL HIM MORE
	JRST	2,@JOBTPC		;IF HE SOMEHOW CONTINUES
BEND

	USE	ZVBLS
↑ZZZ←←.
	USE	VBLS
↑VVV←←.
	USE
↑↑ZHI:	ZZZ
↑↑VHI:	VVV
BEND	SAIL		;WOW
	PATCH:	BLOCK 50
	VAR
	XLIST
	END	START